home *** CD-ROM | disk | FTP | other *** search
/ PCMania 30 / PCMania CD30.iso / postumum / pcapsys / cutpic.pas < prev    next >
Pascal/Delphi Source File  |  1994-11-16  |  3KB  |  91 lines
  1.   (*                 Programa codificado por :                *)
  2.   (*                    Francesc Casanovas                    *)
  3.   (*             Ripness / Postumum    (c) - 1.994            *)
  4.   (*                  en Turbo Pascal v6.0                    *)
  5.  
  6.  
  7. Program CutPic;
  8.  
  9. (*
  10.    Con este programa podremos recortar nuestros ficheros de imagen Bitmap
  11.    en la posicion en la que realmente acaba la imagen para que no ocupe mas
  12.    espacio que el necesario.
  13. *)
  14.  
  15. Uses Crt,Dos,CapSys;
  16.  
  17. Type
  18.        Paleta        = Array [0..255,0..2] Of Byte;
  19. Var
  20.     Pantalla            : Pointer;
  21.     Paleta1             : Paleta;
  22.     Imagen,imagen2      : String;
  23.     Panta               : File;
  24.     panta2              : File;
  25.     cortar              : word;
  26.  
  27.  
  28. Procedure Corta_Pantalla (fichero,fichero2  : String );
  29.  
  30. Var A : Byte;
  31.  
  32.  Begin
  33.     Assign (Panta,Fichero);   { Abrimos los ficheros para lectura y para }
  34.     Assign (Panta2,Fichero2); { escritura }
  35.     Reset (Panta,1);
  36.     Rewrite (Panta2,1);
  37.     Blockread (Panta,Pantalla^,cortar+768);   { Leemos los bytes indicados}
  38.     BlockWrite (panta2,pantalla^,cortar+768); { en la pregunta y luego los }
  39.     Close (Panta);                            { escribimos en el fichero de }
  40.     Close (Panta2);                           { salida }
  41.  End;
  42.  
  43.  
  44. { *********************    MAIN   *******************************  }
  45.  
  46.  
  47. Begin
  48.  
  49.   Getmem (Pantalla,64000);   { Reservamos memoria para la imagen que  }
  50.                              { vamos a leer }
  51.  
  52.   { Comprobamos que se haya pasado bien el parametro (nombre del fichero }
  53.   { y que ademas exista }
  54.  
  55.   If ParamCount < 1 Then
  56.    Begin
  57.      WriteLn;
  58.      WriteLn ('Error, faltan parametros..... Uso VerPan < nombre de fichero > ');
  59.      CursorOn;
  60.      Halt;
  61.    End;
  62.   Imagen := ParamStr(1);
  63.     if (Pos ('.', imagen) = 0) then
  64.   Imagen := Concat (imagen, '.pic');
  65.   If Not Exist (Imagen) Then
  66.   Begin
  67.      WriteLn;
  68.      WriteLn (' Fichero no existente ');
  69.      CursorOn;
  70.      Halt;
  71.   End;
  72.  
  73. { Preguntas referentes al nombre que queremos dar al fichero de salida }
  74. { y la posicion hasta la cual queremos recortar      }
  75.  
  76.   Write ('Desde la posicion 0 hasta donde quieres cortar ? ' );
  77.   Readln (cortar);
  78.   GotoXy (1,Wherey+1);
  79.   Write ('Que nombre quieres darle al fichero de salida ? ' );
  80.   ReadLn (imagen2);
  81.  
  82.   CursorOff;            { Desactivamos el cursor }
  83.   GotoXy (1,Wherey+1);
  84.   WriteLn ('Grabando ..... ');
  85.   Corta_pantalla (Imagen,imagen2);  { Llama a la funcion principal }
  86.   GotoXy (1,Wherey+1);
  87.   WriteLn ('Fichero ya grabado ');
  88.   CursorOn;
  89.  
  90. End.
  91.